perm filename MPRNT.F4[MSS,LCS]3 blob
sn#106243 filedate 1974-06-12 generic text, type T, neo UTF8
00100 C MPRNT.F4********** DRAWS MUSIC ON THE PLOTTER OR XGP **********
00200 C *** READS DATA FROM CLFX, TAIL, FERM, BREP, REST, DRAW1, DRAW2
00300 C LOAD WITH PPSRT, PLTCMD, NOTWRT, ITMSBX, TREST, CLFZ, LOOK
00400
00500 IMPLICIT INTEGER(A-Q,S-Z)
00600 REAL DIS,PWDS,DISX,A,B,STFF,CENTR,POS
00700 COMMON /DL/IXRX,SAVER,NAME
00800 CC DIMENSION V(78),LIST(200)
00900 COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK/SIZ/RSZ,JCEN,KCEN
01000 COMMON/ALF/INP(3),ML/XRN/RN(4000)/STF/RSTFAC(8),RSTJC
01100 COMMON /PLTR/PLT,RHT,DIS/PTR/PWDS(250),ITEM,L,I,IX
01200 COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)/POSI/STFF(8),JJB,POS
01300 COMMON/DPY/GO,RXGP,TOP,BOT
01400 EQUIVALENCE (JC,JQ(1)),(JD,JQ(2)),(JE,JQ(3)),(RJE,RJQ(3))
01500 1,(RJF,RJQ(4)),(JG,JQ(5)),(JH,JQ(6)),(JF,JQ(4)),(RJG,RJQ(5))
01600 1,(RJD,RJQ(2)),(RJC,RJQ(1)),(I1,INP(1))
01700 CC 1,(LIST,RN(3100)),(V,RN(3000))
01800 DATA STFF/-369.0,-246.0,-123.0,0.0,123.0,246.0,369.0,450.0/
01900 1 ,IP/'P'/
02000
02100 TOP2=-999
02200 RXGP=0
02300 I1=0
02400 C RESTART PROG. OR TYPE 'F' TO FINISH PLOTTER.(IT'S NOT AUTOMATIC.)
02500 2 PLOTIT=0
02600 RSZ=.845
02700 TOP=-999
02800 BOT=999
02900 PLT=0
03000 PWDS(1)=1.
03100 EDX=-1
03200 DO 1402 K=1,8
03300 1402 RSTFAC(K)=1.
03400 M=1
03500 ITEM=0
03600 IXRX=0
03700 I=1
03800 58 GO=-1
03900 GO TO 5504
04000
04100
04200 11 CALL NOTWRT
04300 57 IF(PLT)GO TO 6120
04400 ITEM=ITEM+1
04500 IF(EDX.NE.-1.AND.M.LT.I)GO TO 6120
04600 IF(PLOTIT.EQ.-2)GO TO 2311
04700 PWDS(ITEM+1)=I
04800 PLT=0
04900 GO=-1
05000
05100 5504 IF(I1.EQ.IP)GO TO 2311
05200 59 TYPE 56
05300 ACCEPT 89,INP
05400 311 JA=0
05500 IF(I1.NE.IP)GO TO 85
05600 2311 CALL PLTCMD
05700 IF(PLOTIT.EQ.0)GO TO 3005
05800 I1=IP
05900 PLOTIT=-1
06000 C 'PXG' OR 'PXC' GOES TO 'PLOT COMMAND' ROUTINE
06100 89 FORMAT(72A1)
06200
06300 6531 M=1
06400 EDX=-1
06500 DO 5532 K=1,9
06600 5532 JQ(K)=RJQ(K)
06700 590 IF(PLOTIT.EQ.-1)GO TO 121
06800 I1=0
06900 243 RJB=1.
07000 C TO RUN THROUGH DATA.
07100 241 RSZ=.845*RJB
07200 RJB=0
07300 RJC=0
07400 RJD=0
07500 TOP=-999
07600 BOT=999
07700 C GOES TO PLOTTER
07800 85 M=1
07900 I=PWDS(ITEM+1)
08000 ITEM=0
08100 8852 PLT=1
08200 EDX=0
08300 GO=0
08400 GO TO 6120
08500
08600 60 IF(JA.NE.88)GO TO 601
08700 RSTFAC(JC+4)=RJB
08800 C FOR STAFF SIZE FACTOR WITHOUT STAFF.
08900 GO TO 57
09000 601 RSTJC=RSTFAC(JC+4)
09100 5541 POS=STFF(JC+4)
09200 JB=RHORZ(RJB)
09300 C LINE IS DIVIDED INTO 200 POINTS.
09400 CENTR=POS
09500 551 IF(JA.EQ.4.OR.JA.EQ.10)GO TO 25
09600 IF(JA.EQ.7)GO TO 81
09700 IF(JA.LE.12.OR.JA.EQ.30)GO TO 11
09800 IF(JA.EQ.18)GO TO 80
09900 CALL ALPHA
10000 GO TO 57
10100
10200 81 CALL KSIG
10300 GO TO 57
10400
10500 80 CALL METER
10600 GO TO 57
10700
10800 25 CALL ITMSUB
10900 C BAR LINES, BEAMS, STAFF LINES ****
11000 GO TO 57
11100
11200 3005 REWIND 21
11300 C GUARDS AGAINST LOSSAGE!
11400 PLOTIT=-2
11500 CALL IFILE(21,NAME)
11600 C JUMP TO READ BIG FILES
11700 2200 J=ITEM+1
11800 2202 READ(21),X,Y,(PWDS(K),K=J,X+J),(RN(K),K=I,Y+I-2)
11910 CC 1 (PWDS(K),K=J,X+J),(RN(K),K=I,Y+I-2),ISCR,(V(K),K=1,ISCR),
12000 CC 1 LCNT,(LIST(K),K=1,LCNT)
12100 CC READ(21),RSTFAC,STFF
12200 ITEM=ITEM+X
12300 I=Y
12400 GO TO 6531
12500 121 IF(PLOTIT.EQ.0)GO TO 5504
12600 5121 CALL PLTSRT
12700 C IF P5=0 MOVES UP AT START, IF P6=0 MOVES UP AT END.
12800 PLT=-1-JH
12900 C (JH) P8=1 OR 2 FOR 2-PASS PLOTS
13000 M=I
13100 I=I+M-1
13200 IF(RJB.EQ.0)RJB=1.
13300 DIS=RJB*1.24
13400 IF(RJC.EQ.0)RJC=RJB
13500 RHT=RJC*1.2
13600 C 1.24 AND 1.2 ARE TO FIT 8 1/2 X 11 FORMAT
13700 BOT=-BOT*RHT
13800 IF(TOP2.EQ.-999)GO TO 8121
13900 BOT=BOT+TOP2
14000 GO TO 9121
14100 8121 CALL PLOTS(K)
14200 RXGP=995.-BOT
14300 9121 NOMOVE=RJF+RJG*148.*RJC
14400 C RJF=1 FOR NO MOVE AT END. RJG=# OF STAVES TO MOVE FOR NEW STAFF 0.
14500 IXGP=JD
14600 C (JD) P4=1 FOR XGP OUTPUT
14700 IF(JE.NE.0)GO TO 1122
14800 IF(RJD.EQ.0)GO TO 6121
14900 IF(TOP2.NE.-999)RXGP=RXGP-BOT
15000 C MOVES 0 POINT OVER EACH TIME.
15100 GO TO 1122
15200 6121 CALL PLOT(0,BOT,-3)
15300 C MOVES PLOTTER UP IF P5=0.
15400 1122 IXRX=IXGP
15500
15600 C NEXT RUNS THROUGH DATA WITH NEW CHANGES.
15700 6120 IF(M.GE.I)GO TO 7120
15800 CNT=RN(M)
15900 DO 6220 K=CNT+1,10
16000 JQ(K)=0
16100 6220 RJQ(K)=0
16200 JA=RN(M+1)
16300 M=M+2
16400 RJB=RN(M)
16500 DO 9120 K=1,CNT
16600 RJQ(K)=RN(M+K)
16700 9120 JQ(K)=RJQ(K)
16800 M=CNT+M+1
16900 IF(EDX.LE.0)GO TO 60
17000 GO TO 5504
17100
17200 7120 M=1
17300 IF(EDX)GO TO 71201
17400 IF(PLT.EQ.1)EDX=-1
17500 PLT=0
17600 C RETURNS FOR 'SL'=SAVE LAST
17700 GO TO 5504
17800 71201 X=50*RHT
17900 TOP=TOP*RHT+X
18000 IF(NOMOVE.NE.0)TOP=0
18100 IF(NOMOVE.GT.1)TOP=NOMOVE
18200 IF(IXGP.EQ.0)CALL PLOT(0,TOP,3)
18300 TOP2=TOP
18400 GO TO 2
18500 C TO MOVE 'PLOTTER' FOR XGP OUTPUT
18600 C MOVES PLOTTER UP
18700 C ALWAYS START PLOT WITH BOTTOM UNIT ON PAGE AND WORK UP.
18800
18900 56 FORMAT(' PXG OR PXC'/)
19000 END